MacFormat 1995 May/macformat-024.iso/Shareware City/Developers/TransSkel Pascal 2.5/TransSkel/ManyWind ƒ/ManyWind.p

Text File | 1994-12-12 | 7.4 KB | 281 lines | [TEXT/PJMM]

{    ManyWind TransSkel demonstration}

{    This application allows up to twenty windows to be created at once,}
{    with the New item under the File menu.  The name of each window}
{    appears under the Windows menu (which is not created until at least}
{    one window exists).  Selecting the window name from the Windows menu}
{    brings the window to the front.  For every window created, Skel is}
{    told to create a new handler.  If the window's close box is clicked,}
{    the handler removes the window name from the Windows menu, disposes}
{    of the window, and removes itself from the window handler list.  If}
{    the window was the last window, the Windows menu handler removes}
{    itself from the menu handler list.}

{    When the first window is created, a Color menu also appears.  This}
{    allows the color of the content region of the frontmost window to}
{    be changed.  It goes away when the last window is closed.}

{    To quit, select Quit from the File menu or type command-Q.}

{    ManyWind demonstrates dynamic window and menu creation and disposal.}
{    It also shows how handler procedures may be shared among handlers}
{    for different windows.}

{    The project should include this file, TransSkel.p (or a library }
{    built from TransSkel.p), Runtime.lib and Interface.lib .}

{    28 June 1986        Paul DuBois}
{    7 January 1987 Owen Hartnett, Ωhm Software Co.    }
{     6 June 1988 OH, changes for version 2.00 }

program ManyWind;

    uses
{$IFC UNDEFINED THINK_PASCAL}
        Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf,
{$ENDC}
        TransSkel;

    const
        maxWind = 20;    { maximum number of windows existing at once }

        aMenuNum = 1;    { Apple menu }
        fMenuNum = 2;        { File menu }
        wMenuNum = 3;        { Windows menu }
        cMenuNum = 4;        { Color menu }

        new = 1;
        quit = 3;

        cWhite = 1;
        cLtGray = 2;
        cGray = 3;
        cDkGray = 4;
        cBlack = 5;

    var
        fileMenu, windowMenu, colorMenu: MenuHandle;

        windCount: integer;    { number of currently existing windows }
        windNum: longint;    { id of last window created }

        dummy: Boolean;        { may be used for memory management }

    procedure MakeWindow;
    forward;
    procedure DoWClose;
    forward;

    procedure DoWUpdate;

        var
            thePort: GrafPtr;

    begin
        GetPort(thePort);
        EraseRect(thePort^.portRect);    { repaint w/background pattern }
    end;

    procedure DoMClobber (theMenu: MenuHandle);

    begin
        DisposeMenu(theMenu);
    end;

    procedure DoFileMenu (item: integer);

    begin
        case item of
            quit:
                SkelWhoa;        { tell SkelMain to quit }
            new:
                MakeWindow;    { make a new window }
        end;
    end;

{    Dispose of window.  Skel makes sure the port is pointing to the}
{    appropriate window, so this procedure can determine which window}
{    is to be disposed, of without being told explicitly.}


    procedure DoWClobber;

        var
            thePort: GrafPtr;

    begin
        GetPort(thePort);                { grafport of window to dispose of }
        DisposeWindow(WindowPtr(thePort));
    end;

{    Change the background pattern of the frontmost window.  Ignore}
{    if the front window is a DA window.}

    procedure DoColorMenu (item: integer);

        var
            w: WindowPeek;
            w2: WindowPtr;

    begin
        w := WindowPeek(FrontWindow);
{•  SetPort(WindowPtr(w));                {*** Fixed bug in original windows    •]}
        if w^.windowKind >= 0 then             { front is not DA window }
            begin
                case item of
{$IFC UNDEFINED THINK_PASCAL}
                    cWhite:
                        BackPat(qd.white);
                    cLtGray:
                        BackPat(qd.ltGray);
                    cGray:
                        BackPat(qd.gray);
                    cDkGray:
                        BackPat(qd.dkGray);
                    cBlack:
                        BackPat(qd.black);
{$ELSEC}
                    cWhite:
                        BackPat(white);
                    cLtGray:
                        BackPat(ltGray);
                    cGray:
                        BackPat(gray);
                    cDkGray:
                        BackPat(dkGray);
                    cBlack:
                        BackPat(black);
{$ENDC}
                end;
                w2 := WindowPtr(w);
                EraseRect(w2^.portRect);
            end;
    end;


    procedure DoWindowMenu (item: integer);

        var
            iTitle, wTitle: Str255;
            w: WindowPeek;

    begin
        GetItem(windowMenu, item, iTitle);     { get window name }
        w := WindowPeek(FrontWindow);
        while w <> nil do
            begin
                GetWTitle(WindowPtr(w), wTitle);
                if EqualString(iTitle, wTitle, false, true) then
                    begin
                        SelectWindow(WindowPtr(w));
                        w := nil;
                    end;
                if w <> nil then
                    w := w^.nextWindow;
            end;
    end;

{    Make new window.  Locate at (100, 100) if no other windows, else}
{    offset slightly from front window.  The window title is the next}
{    window number (1, 2, 3, ...).  If this is the first window, create}
{    the Windows and Color menus.  Add the window title as the last item}
{    of the Windows menu.}

{    If the maximum window count has been reached, disable New in the}
{    File menu.}

    procedure MakeWindow;

        var
            w: WindowPtr;
            r, r2: Rect;
            s: Str255;

    begin
        SetRect(r, 0, 0, 200, 150);
        w := FrontWindow;
        if w = nil then
            OffsetRect(r, 100, 100)
        else
            begin
                r2 := w^.portBits.bounds;
                OffSetRect(r, 20 - r2.left, 20 - r2.top);
                if (r.left > 480) or (r.top > 300) then    { keep on screen }
                    OffsetRect(r, 40 - r.left, 40 - r.top);
            end;
        WindNum := windnum + 1;
        NumToString(windNum, s);
        w := NewWindow(nil, r, s, true, documentProc, WindowPtr(-1), true, 0);
        dummy := SkelWindow(w, nil, nil, @DoWUpdate, nil, @DoWClose, @DoWclobber, nil, false);
        windCount := windCount + 1;
        if windCount - 1 = 0 then     { if first window, create new menus }
            begin
                colorMenu := NewMenu(cMenuNum, 'Color');
                AppendMenu(colorMenu, 'White;Light Gray;Gray;Dark Gray;Black');
                dummy := SkelMenu(colorMenu, @DoColorMenu, @DoMClobber, false);
                windowMenu := NewMenu(wMenuNum, 'Windows');
                dummy := SkelMenu(windowMenu, @DoWindowMenu, @DoMClobber, true);
            end;
        AppendMenu(windowMenu, s);
        if windCount = maxWind then
            DisableItem(fileMenu, new);
    end;

{    Mouse was clicked in close box.  Remove the window handler (which}
{    causes the window to be disposed of), and delete the window title}
{    from the Windows menu.  If the window was the last one, delete the}
{    Windows and Color menus entirely.}

{    Skel makes sure the port is pointing to the appropriate window, so}
{    this procedure can determine which window had its close box clicked,}
{    without being told explicitly.}

    procedure DoWClose;

        var
            thePort: GrafPtr;
            m: MenuHandle;
            i, mItems: integer;
            iTitle, wTitle: Str255;

    begin
        GetPort(thePort);            { grafport of window to be closed }
        GetWTitle(WindowPtr(thePort), wTitle);
        SkelRmveWind(WindowPtr(thePort));
        windCount := windCount - 1;
        if windCount = 0 then
            begin
                SkelRmveMenu(windowMenu);    { last window - clobber menus }
                SkelRmveMenu(colorMenu);
            end
        else
            begin    { just take out of menu }
                m := NewMenu(wMenuNum, 'Windows');
                mItems := CountMItems(windowMenu);
                for i := 1 to mItems do
                    begin
                        GetItem(windowMenu, i, iTitle);
                        if not EqualString(iTitle, wTitle, false, true) then
                            AppendMenu(m, iTitle);
                    end;
                SkelRmveMenu(windowMenu);    { remove old Windows menu }
                windowMenu := m;                { and install new one }
                dummy := SkelMenu(windowMenu, @DoWindowMenu, @DoMClobber, true);
            end;
        EnableItem(fileMenu, new);    { can always create at least one more now }
    end;


begin

    WindCount := 0;
    WindNum := 0;
    SkelInit(6, nil);                                            { initialize }
    SkelApple('(About ManyWind…', nil);                                { handle desk accessories }
    fileMenu := NewMenu(fMenuNum, 'File');        { make File menu handler }
    AppendMenu(fileMenu, 'New/N;(-;Quit/Q');
    SkelGrowBounds(nil, 50, 10, 500, 300);
    dummy := SkelMenu(fileMenu, @DoFileMenu, @DoMClobber, true);
    SkelMain;                                        { loop 'til Quit selected }
    SkelClobber;                                    { clean up }
end.